home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb2 / pro16 / bitlist.bas < prev    next >
Encoding:
BASIC Source File  |  1991-12-28  |  8.4 KB  |  222 lines
  1. '****************************************************
  2. '*  BITLIST.BAS - routines to manipulate bit lists  *
  3. '****************************************************
  4.  
  5. ' $INCLUDE: 'BITLIST.BI'
  6.  
  7. CONST FALSE = 0, TRUE = NOT FALSE
  8.  
  9. CONST CPI = 2                   ' # chars in 1 integer
  10. CONST CS = 8                    ' # bits  in 1 character
  11.  
  12. FUNCTION blCreate (Size%)
  13. '****************************************************
  14. '*  blCreate - create a bitlist                     *
  15. '*                                                  *
  16. '*  INP:  Size - number of bits in the list         *
  17. '*  OUT:  'handle' of the new bitlist, NULL if      *
  18. '*        the bitlist could not be created.         *
  19. '****************************************************
  20. SHARED MAllocSpace$, MasterPointers$, FirstFree%
  21. IF FirstFree% = 0 THEN
  22.   ' this is the first allocation, no master pointers exist yet
  23.   MasterPointers$ = STRING$(2, 0)
  24.   FirstFree% = LEN(MasterPointers$) + 1
  25.   NextList% = (FirstFree% - 1) \ 2
  26.   mPtr% = FirstFree% - 2
  27. ELSE
  28.   IF FirstFree% = LEN(MasterPointers$) + 1 THEN
  29.     ' normal allocation, no master pointers have been freed
  30.     MasterPointers$ = MasterPointers$ + STRING$(2, 0)
  31.     FirstFree% = LEN(MasterPointers$) + 1
  32.     NextList% = (FirstFree% - 1) \ 2
  33.     mPtr% = FirstFree% - 2
  34.   ELSE
  35.     ' re-use a previously freed master pointer
  36.     NextList% = (FirstFree% + 1) \ 2
  37.     mPtr% = FirstFree%
  38.     FirstFree% = ABS(CVI(MID$(MasterPointers$, mPtr%, 2)))
  39.   END IF
  40. END IF
  41. lPtr% = LEN(MAllocSpace$) + 1
  42. MAllocSpace$ = MAllocSpace$ + STRING$(((Size%+CS-1)\CS+CPI),0)
  43. MID$(MAllocSpace$, lPtr%, 2) = MKI$(Size%)
  44. MID$(MasterPointers$, mPtr%, 2) = MKI$(lPtr%)
  45. blCreate = NextList%
  46. END FUNCTION
  47.  
  48. SUB blDestroy (BitList%)
  49. '****************************************************
  50. '*  blDestroy - destroy a bitlist                   *
  51. '*                                                  *
  52. '*  INP:  BitList% - 'handle' to bitlist to destroy *
  53. '****************************************************
  54. SHARED MAllocSpace$, MasterPointers$, FirstFree%
  55. ' de-reference the bitlist handle
  56. drBl% = CVI(MID$(MasterPointers$, BitList%*2-1, 2))
  57. ' Adjust the master pointers that come after the master pointer that
  58. ' points to the bitlist being destroyed.
  59. ' (if this was not the bitlist pointed to by the last master pointer
  60. '  in the master pointer list)
  61. IF BitList% * 2 < LEN(MasterPointers$) THEN
  62.   Adjustment% = (CVI(MID$(MAllocSpace$, drBl%, 2)) + CS - 1) \ CS + CPI
  63.   FOR aBl% = BitList% + 1 TO LEN(MasterPointers$) \ 2
  64.      mPtr% = CVI(MID$(MasterPointers$, aBl% * 2 - 1, 2))
  65.      IF mPtr% > 0 THEN
  66.        ' (pointers with values less than 1 are in the free list)
  67.        MID$(MasterPointers$, aBl% * 2 - 1, 2) = MKI$(mPtr% - Adjustment%)
  68.      END IF
  69.   NEXT aBl%
  70. END IF
  71. ' Do garbage collection on the master pointer list
  72. mPtr% = BitList% * 2 - 1
  73. MID$(MasterPointers$, mPtr%, 2) = MKI$(0)
  74. IF mPtr% + 1 = LEN(MasterPointers$) THEN
  75.   ' this is the master pointer at the end of the list,
  76.   ' so just get rid of it. We'll allocate it again if we need to.
  77.   MasterPointers$ = LEFT$(MasterPointers$, mPtr% - 1)
  78. ELSE
  79.   IF FirstFree% > LEN(MasterPointers$) THEN
  80.     ' this is the first master pointer we've freed
  81.     FirstFree% = mPtr%
  82.   ELSE
  83.     ' add this master pointer to the free list
  84.     Prev% = 0: Done% = FALSE: WorkPtr% = FirstFree%
  85.     DO UNTIL Done%
  86.       ' look for the end of the list
  87.       NextPtr% = ABS(CVI(MID$(MasterPointers$, WorkPtr%, 2)))
  88.       IF NextPtr% = 0 THEN
  89.         ' we've found the end of the free list
  90.         ' set this node to pint to the master pointer we just freed
  91.         MID$(MasterPointers$, WorkPtr%, 2) = MKI$(-mPtr%)
  92.         Done% = TRUE
  93.       ELSE
  94.         ' follow the link
  95.         WorkPtr% = NextPtr%
  96.       END IF
  97.     LOOP
  98.   END IF
  99. END IF
  100. ' reclaim the space used by the list being destroyed
  101. listLen% = CVI(MID$(MAllocSpace$, drBl%, 2))
  102. SubStrLen% = (listLen% + CS - 1) \ CS + CPI
  103. Front$ = LEFT$(MAllocSpace$, drBl% - 1)
  104. RearStart% = drBl% + SubStrLen%
  105. Rear$ = MID$(MAllocSpace$, RearStart%, LEN(MAllocSpace$) - RearStart% + 1)
  106. MAllocSpace$ = Front$ + Rear$: Front$ = "": Rear$ = ""
  107. END SUB
  108.  
  109. FUNCTION blGetBit (bl%, BitNum%)
  110. '****************************************************
  111. '*  blGetBit - return current bit state             *
  112. '*                                                  *
  113. '*  INP:  bl% - 'handle' to bitlist of interest     *
  114. '*        BitNum% - the bit number of interest      *
  115. '*  OUT:  FALSE is bit is off or out of range,      *
  116. '*        TRUE otherwise.                           *
  117. '****************************************************
  118. SHARED MAllocSpace$, MasterPointers$, FirstFree%
  119. ' de-reference the bitlist handle
  120. drBl% = CVI(MID$(MasterPointers$, bl%*2-1, 2))
  121. IF BitNum% >= CVI(MID$(MAllocSpace$, drBl%, 2)) THEN
  122.   fRes% = FALSE
  123. ELSE
  124.   ByteNum% = BitNum% \ 8 + CPI
  125.   fRes% = ASC(MID$(MAllocSpace$, drBl%+ByteNum%, 1)) AND 2 ^ (BitNum% MOD 8)
  126. END IF
  127. blGetBit = fRes%
  128. END FUNCTION
  129.  
  130. FUNCTION blSetBit (bl%, BitNum%, State%)
  131. '****************************************************
  132. '*  blSetBit - return current bit state             *
  133. '*                                                  *
  134. '*  INP:  bl% - 'handle' to bitlist of interest     *
  135. '*        BitNum% - the bit number of interest      *
  136. '*        State% - the new bit state                *
  137. '*  OUT:  TRUE on error, FALSE otherwise            *
  138. '****************************************************
  139. SHARED MAllocSpace$, MasterPointers$, FirstFree%
  140. ' de-reference the bitlist handle
  141. drBl% = CVI(MID$(MasterPointers$, bl%*2-1, 2))
  142. IF BitNum% >= CVI(MID$(MAllocSpace$, drBl%, 2)) THEN
  143.   fRes% = TRUE
  144. ELSE
  145.   ByteNum% = BitNum% \ 8 + CPI
  146.   Mask% = 2 ^ (BitNum% MOD 8)
  147.   IF State% THEN
  148.     MID$(MAllocSpace$, drBl%+ByteNum%, 1) = _
  149.          CHR$(ASC(MID$(MAllocSpace$, drBl%+ByteNum%, 1)) OR Mask%)
  150.   ELSE
  151.     MID$(MAllocSpace$, drBl%+ByteNum%, 1) = _
  152.          CHR$(ASC(MID$(MAllocSpace$, drBl%+ByteNum%, 1)) _
  153.          AND ((NOT Mask%) AND &HFF))
  154.   END IF
  155.   fRes% = FALSE
  156. END IF
  157. blSetBit = fRes%
  158. END FUNCTION
  159.  
  160. FUNCTION blListOp (Op%, bl1%, bl2%)
  161. '****************************************************
  162. '*  blListOp - perform a list operation             *
  163. '*                                                  *
  164. '*  INP:  Op% - operation code to perform:          *
  165. '*             blUNION, blINTERSECT,  blCLEAR       *
  166. '*             blCOPY, blSET,         blINVERT      *
  167. '*        bl1% - bitlist #1                         *
  168. '*        bl2% - bitlist #2 (or 0 if no 2nd bitlist *
  169. '*              as for blCLEAR, blSET & blINVERT    *
  170. '*                                                  *
  171. '*  OUT:  TRUE if UNION or INTERSECT or COPY detect *
  172. '*             that the lists are different sizes,  *
  173. '*        FALSE otherwise.                          *
  174. '****************************************************
  175. SHARED MAllocSpace$, MasterPointers$, FirstFree%
  176. ' de-reference the bitlist handles
  177. drBl1% = CVI(MID$(MasterPointers$, bl1%*2-1, 2))
  178. IF bl2% <> 0 THEN
  179.   drBl2% = CVI(MID$(MasterPointers$, bl2%*2-1, 2))
  180. END IF
  181. IF Op% = blUNION OR Op% = blINTERSECT OR Op% = blCOPY THEN
  182.   IF CVI(MID$(MAllocSpace$, drBl1%, 2)) <> CVI(MID$(MAllocSpace$, drBl2%, 2)) _
  183.    THEN
  184.     fRes% = TRUE
  185.     EXIT FUNCTION
  186.   END IF
  187. END IF
  188.  
  189. drBl1Len% = (CVI(MID$(MAllocSpace$, drBl1%, 2)) + CS-1)\CS
  190. fRes% = FALSE
  191. SELECT CASE Op%
  192.       CASE blCLEAR
  193.           MID$(MAllocSpace$, drBl1%+CPI, drBl1Len%) = STRING$(drBl1Len%, 0)
  194.       CASE blSET
  195.           MID$(MAllocSpace$, drBl1%+CPI, drBl1Len%) = STRING$(drBl1Len%, 255)
  196.       CASE blINVERT
  197.           FOR I%=CPI TO drBl1Len%+CPI-1
  198.              MID$(MAllocSpace$, drBl1%+I%, 1) = _
  199.                CHR$((NOT ASC(MID$(MAllocSpace$, drBl1%+I%, 1)) AND &HFF))
  200.           NEXT I%
  201.       CASE blUNION
  202.           FOR I%=CPI TO drBl1Len%+CPI-1
  203.              MID$(MAllocSpace$, drBl1%+I%, 1) = _
  204.                CHR$(ASC(MID$(MAllocSpace$, drBl1%+I%, 1)) _
  205.                  OR ASC(MID$(MAllocSpace$, drBl2%+I%, 1)))
  206.           NEXT I%
  207.       CASE blINTERSECT
  208.           FOR I%=CPI TO drBl1Len%+CPI-1
  209.              MID$(MAllocSpace$, drBl1%+I%, 1) = _
  210.                CHR$(ASC(MID$(MAllocSpace$, drBl1%+I%, 1)) _
  211.                 AND ASC(MID$(MAllocSpace$, drBl2%+I%, 1)))
  212.           NEXT I%
  213.       CASE blCOPY
  214.           MID$(MAllocSpace$, drBl1%+CPI, drBl1Len%) = _
  215.            MID$(MAllocSpace$, drBl2%+CPI, drBl1Len%)
  216.       CASE ELSE
  217.           fRes% = TRUE
  218. END SELECT
  219. blListOp = fRes%
  220. END FUNCTION
  221.  
  222.